#!/usr/bin/perl -w
use strict;

#  	mailquotad  is used in conjunction with exim for checking the quotas
#	of a mailbox at RCPT TO time.
#
#   	Copyright (C) 2008 Igor Popov <ipopovi@gmail.com>
#	
#	This program is free software; you can redistribute it and/or
#	modify it under the terms of the GNU General Public License
#	as published by the Free Software Foundation; either version 2
#	of the License, or (at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with this program; if not, write to the Free Software
#	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
						

use Getopt::Std;
use POSIX;
use File::Basename;
use Fcntl qw/LOCK_EX LOCK_NB/;
use File::Find;
use IO::Socket;
use Sys::Syslog qw/:standard :macros/;

use vars qw/$work $sockname $pidfile $debugmode $server_user $server_group
    $mail_spool_prefix $opt_h $opt_d $opt_s $opt_p $opt_u $opt_g $opt_m/;


# default values
$sockname = '/var/run/quotad/mailquotad.sock';
$pidfile  = '/var/run/quotad/mailquotad.pid';
$mail_spool_prefix = '/var/spool/mail';
$server_user = 'mailnull';
$server_group = 'mailnull';
$debugmode = 0;

# cli options
getopts('hd:s:p:u:g:m:');

if ($opt_h) {
    print <<'USAGE';
-h this help message
-d <maildir> run in debug mode, do not became daemon
-s <UNIX socket path|IP address:port>
-p <pid file path>
-u <user>
-g <group>
-m <mail spool prefix>

USAGE

    exit(0);
}

if ($opt_d) {
    # This debug mode allows you to run your own checks against the maildir quota checker.
    $debugmode = 1;
    checkquota($opt_d);
    exit;
}
if ($opt_s) {
    $sockname = $opt_s;
}
if ($opt_p) {
    $pidfile = $opt_p;
}
if ($opt_u) {
    $server_user = $opt_u;
}
if ($opt_g) {
    $server_group = $opt_g;
}
if ($opt_m) {
    $mail_spool_prefix = $opt_m;
    die "mail spool prefix doesn't exist" unless (-d $mail_spool_prefix);
}


# program
$work = 1;

my $program_name = basename($0);

# open syslog
openlog($program_name, "ndelay,pid", LOG_DAEMON);
syslog(LOG_INFO, "start daemon");

# check if we are already running
open(SELFLOCK, '<', "$0") or error(LOG_ERR, "aborting: couldn't open $0: $!\n");
flock(SELFLOCK, LOCK_EX | LOCK_NB) or error(LOG_ERR, "aborting: another $program_name is already running\n");

chdir('/') or error(LOG_ERR, "aborting: can't chdir to '/': $!");

# drop privileges
setgid((getgrnam($server_user))[2])  or error(LOG_ERR, "aborting: setgid() failed: $?");
setuid((getpwnam($server_group))[2]) or error(LOG_ERR, "aborting: setuid() failed: $?");

# daemonize so that we run in the background.
defined (my $pid = fork) or error(LOG_ERR, "can't fork: $!");
exit if ($pid);

# set signal handlers
foreach my $sig ($SIG{TSTP}, $SIG{TTIN}, $SIG{TTOU}, $SIG{HUP}, $SIG{PIPE}) {
    $sig = 'IGNORE';
}
# avoiding zombies
$SIG{CHLD} = \&child_reap;
# normally exits 
$SIG{INT} = $SIG{TERM} = \&stop_working;

# record our pid.
open(PIDFILE, '>', "$pidfile") or error(LOG_ERR, "can't create pidfile $pidfile: $!");
print PIDFILE getpid();
close(PIDFILE) or warning(LOG_WARNING, "close pidfile $pidfile failed: $!");

# close tty
open STDIN, '/dev/null' or error(LOG_ERR, "can't read /dev/null: $!");
open STDOUT, '>>/dev/null' or error(LOG_ERR, "can't write to /dev/null: $!");
open STDERR, '>>/dev/null' or error(LOG_ERR, "can't write to /dev/null: $!");
setsid or error(LOG_ERR, "can't start a new session: $!");

# do the main bit.
mainloop();

sub mainloop {
    my ($socket, $child) = (undef, undef, undef);

    # change our name
    $0 = "mailquotad";
    
    # make the socket and listen to it.
    if ($sockname =~ m{^/}) { # unix socket
	if (-S $sockname) {
	    unlink($sockname) or error(LOG_ERR, "unlink `$sockname' failed: $!");
	}    
	$socket = new IO::Socket::UNIX(Local => $sockname,
				  Type => SOCK_STREAM,
				  Listen => SOMAXCONN,
				  ReuseAddr => 1) or error(LOG_ERR, "socket `$sockname' failed: $!");
	chmod(0666, $sockname) or warning(LOG_WARNING, "chmod `$sockname' failed: $!");
    } else { # tcp socket
	$socket = new IO::Socket::INET(LocalAddr => $sockname,
				  Proto => 'tcp',
				  Type => SOCK_STREAM,
				  Listen => SOMAXCONN,
    				  ReuseAddr => 1) or error(LOG_ERR, "socket failed: $!");
    }
    	
    while ($work) {
	while (my $client_socket = $socket->accept()) {
	    unless (defined($child = fork())) {
		warning(LOG_ERR, "fork failed: $!") ;
	    } elsif ($child) { # parent
		$client_socket->close();
	    } else { # child
		$socket->close();
		$client_socket->autoflush(1);
		my $client_addr = sprintf("%s:%s", $client_socket->peerhost(), $client_socket->peerport());
		my $buf = undef;
		warning(LOG_DEBUG, "client `$client_addr' has connected");
		
		# set timeout values
		$client_socket->setsockopt(SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', 15, 0)) or warning(LOG_ERR, "setsockopt failed: $!");
		$client_socket->setsockopt(SOL_SOCKET, SO_SNDTIMEO, pack('L!L!', 15, 0)) or warning(LOG_ERR, "setsockopt failed: $!");

		# read the socket, expecting a path.
		$client_socket->recv($buf, 8192);
		if (length($buf)) {
		    chomp($buf);
		    my ($localpart, $domain, $quota) = split(/:/, $buf, 3);
		    if (defined($localpart) and defined($domain) and defined($quota)) {
			my $quotastatus = (checkquota("$domain/$localpart") < $quota)? 'good' : 'bad';
			$client_socket->send($quotastatus) == length($quotastatus) or warning(LOG_ERR, "send failed: $!");
			warning(LOG_DEBUG, "quota for maildir for `$domain/$localpart' is `$quotastatus'");
		    } else {
			warning(LOG_INFO, "client `$client_addr' sends garbage: `$buf'");
		    }
		}

		if ($client_socket->connected()) {
		    $client_socket->close() or warning(LOG_ERR, "close client `$client_addr' socket failed: $!");
		}
		warning(LOG_DEBUG, "child is going to exit");
		exit(0);
	    }
	}
    }
    warning(LOG_INFO, "stop daemon");
    $socket->close() or warning(LOG_ERR, "close main socket failed: $!");
    unlink($sockname) if ($sockname =~ m{^/}); # remove unix socket
    unlink($pidfile) or warning(LOG_ERR, "unlink pidfile failed: $!");
    closelog();
    exit(0);
}

sub checkquota {
    my $maildir = shift @_;
    my $size = 1024*512;
    return -1 unless (-d "${mail_spool_prefix}/${maildir}");
    find( sub { $size += -s if -f; }, "${mail_spool_prefix}/${maildir}");
    warning(LOG_DEBUG, "maildirsize for $maildir is $size");
    return int($size/1024/1024);
}

sub child_reap {
    1 until (-1 == waitpid(-1, WNOHANG));
    $SIG{CHLD} = \&child_reap;
}

sub stop_working {
    my $signame = shift;
    $work = undef;
    $SIG{INT} = $SIG{TERM} = \&stop_working;
    warning(LOG_INFO, "SIG$signame received");
}

sub error {
    my ($priority, $message, $exitcode) = shift @_;
    $exitcode = 1 unless (defined $exitcode);
    
    if ($debugmode) {
	print STDERR $message, "\n";
    } else {
	syslog($priority, "%s", $message);
    }
    closelog();
    exit($exitcode);
}

sub warning {
    my ($priority, $message) = @_;
    
    if ($debugmode) {
	print STDERR $message, "\n";
    } else {
	syslog($priority, "%s", $message);
    }
}
